QRZ! Ham Radio 6/QRZ Ham Radio Callsign Database - Volume 6.iso/pc/files/mac/proj_a1.hqx/Project Mac - A1/Ham Grid Dist & Direction

AmigaBASIC Source Code | 1987-12-04 | 4.0 KB | 152 lines

'  ********************************************************
'  *  This program is from "The ARRL World Grid Locator Atlas"                *
'  *  Copyright 1984 Folke Rosval, SM5AGM.  This atlas is Available         *
'  *  from ARRL HQ for $4.00 . This program entered and modified for the *             *
'  *  Macintosh by  Jim Bradbury, WB5ACL / DA2ND, December 1987         *
'  ********************************************************
    PRINT "This Program computes Direction and Distance between"
    PRINT "two Grid Locations."
    PRINT
100 X0=6378.14
       X1=6356.75
       X2=0.014
       X3=1.8
       X4=4
       X5=2*ATN(1)
       X6=2*X5
       X7=2*X6
110 X8=X5/90
       A = X0*X0
       B = X1 * X1
       B = 1 + (A-B)/B
       C = SQR(B)
       A = A/X1
       X9 = (1+1/C/B)*A/2
120 Y0=A-X9
        Y1=(X0+A)/2
        Y2=A-Y1
        Y3=(2*X9/X0-1)*X6
        Y4=X0-X9
        Y5=X7*(1-X9/X0)
 130 YD5=Y5*Y5
 140 PRINT "Grid Locations can be:"
        PRINT  "Two Letters                                               ->           ";
        <0x2108762d,0x21082010>(12):<0x1a,0x02>(0):<0x1a,0x01>(0):PRINT"JN"
        <0x21087679,0x21082010>(12):<0x14,0x02>(0):<0x14,0x01>(9)
        PRINT  "Two Letters and Two Numbers                   ->           ";
        <0x21087709,0x21082010>(12):<0x1d,0x02>(0):<0x1d,0x01>(0):PRINT "JN49"
        <0x21087758,0x21082010>(12):<0x14,0x02>(0):<0x14,0x01>(9)
        PRINT  "or, Two Letters, Two Numbers, and Two Letters ->  ";
        <0x210877df,0x21082010>(12):<0x1f,0x02>(0):<0x1f,0x01>(0):PRINT "JN49GL"
        <0x21087830,0x21082010>(12):<0x14,0x02>(0):<0x14,0x01>(9)
        PRINT
     INPUT"Enter FROM Grid Location " ;A$
         LOC1$=A$
         GOSUB 290
         IF E = 1 THEN E = 0: GOTO 140
  150 A = C * X8
          B = D * X8
  160 INPUT "Enter TO Grid Location ";A$
           LOC2$=A$
         GOSUB 290
         IF E = 1 THEN E = 0: GOTO 160
  170 C=C*X8
         D=D*X8
         E=C-A
         F=SIN(B)
         G=SIN(D)
         H=COS(B)
         I=COS(D)
         J=COS(E)
  180 K = F*G+H*I*J
          GOSUB 370
          M = L
          IF ABS(K) < 1 THEN N = (G*H-I*F*J)/SQR(1-K*K)
   190 K = N
           GOSUB 370
           G = L
           I = M/X4
           J = -I/3
           P = 0
           FOR Q = 1 TO 4
               J = J + I
               K = COS(J)*F+SIN(J)*H*N
               GOSUB 370
               R = 0
               IF L <> 0 THEN R = H*SIN(G)/SIN(L)
               S = R * X5
               IF ABS(R) < 1 THEN S = ATN(R/SQR(1-R*R))
               R = COS(2*L)
               T = X9 + Y0*R
               R = Y1 + Y2*R
               P = P + (T+R)/2 + (T-R)/2*COS(2*S)
           NEXT
           F = P / X4
           H = 0
           I = M-Y3
           IF I > 0 THEN H = I*I*(F-X9)/Y5
    240 I = SIN(X6*(X0-F)/Y4)
           J = Y3*(1-X2*I)
           IF M > J THEN H = H +X3*I*SIN(X6*SQR((X6-M)/(X6-J)))
           F = (F-H)*M
           IF F < 0.5 OR F > 20003.5 THEN G = 0: GOTO 280
    270 IF E * (X6-ABS(E)) < 0 THEN G = X7-G

 280 PRINT
        PRINT "From Grid location ";
        <0x21087e28,0x21082010>(12):<0x1b,0x02>(0):<0x1b,0x01>(0):PRINT LOC1$
        <0x21087e76,0x21082010>(12):<0x14,0x02>(0):<0x14,0x01>(9)
        PRINT "            to location ";
        <0x21087ee2,0x21082010>(12):<0x1b,0x02>(0):<0x1b,0x01>(0):PRINT LOC2$
        <0x21087f30,0x21082010>(12):<0x14,0x02>(0):<0x14,0x01>(9)
        PRINT " The Direction is ";
        <0x21087f96,0x21082010>(12):<0x2d,0x02>(0):<0x2d,0x01>(0):PRINT INT(G/X8+0.5);"í,";
        <0x21087ff2,0x21082010>(12):<0x14,0x02>(0):<0x14,0x01>(9)
        PRINT " and the Distance is ";
        <0x2108805b,0x21082010>(12):<0x24,0x02>(0):<0x24,0x01>(0):PRINT INT(F+0.5);
        PRINT "Kilometers."
        <0x210880cb,0x21082010>(12):<0x1d,0x02>(0):<0x1d,0x01>(9):PRINT:GOTO 160

   290 F = LEN(A$)
           IF F <> 2 AND F <> 4 AND F <> 6 THEN E = 1: RETURN

   300 FOR G = 1 TO F
               A(G) = ASC(MID$(A$,G,1))
          NEXT
' IF Lower Case, Change to Upper Case
          FOR G = 1 TO F
               IF A(G) > 82 THEN A(G) = A(G) - 32
          NEXT

   310 IF A(1) < 65 OR A(1) > 82 OR A(2) < 65 OR A(2) > 82 THEN E = 1: RETURN

   320 C = A(1) *20-1480
           D = A(2) * 10 - 740
           IF F = 2 THEN C = C+ 10 : D = D + 5: RETURN

   330 IF A(3) < 48 OR  A(3) > 57 OR  A(4) < 48 OR  A(4) > 57 THEN E = 1:RETURN

   340 C = C + A(3)*2-96
           D = D + A(4)-48
           IF F = 4 THEN C = C + 1: D = D + 0.5: RETURN

   350 IF A(5) < 65 OR  A(5) > 88 OR  A(6) < 65 OR  A(6) > 88 THEN E = 1: RETURN

   360 C = C+(A(5)-64.5) / 12
           D = D + (A(6)-64.5)/24
           RETURN

   370 IF K > 1 THEN K = 1: L = 0: RETURN

   380 IF K <= -1 THEN K = -1: L = X6: RETURN

   390 L = X5-ATN(K/SQR(1-K*K)): RETURN